Celestin Apprentice 5/Apprentice-Release5.iso/Source Code/Pascal/Snippets/DimText Pascal 1.0/Dim_text.p

Text File | 1995-04-18 | 10.4 KB | 352 lines | [TEXT/PJMM]

unit Dim_text;

interface

    uses
        Appletalk, CTBUtilities;

    procedure Init_dimmer (dp: DialogPtr);
    procedure Dispose_dimmer (dp: DialogPtr);
    procedure New_dimmables (dp: DialogPtr);
    procedure Dispose_dimmables (dp: DialogPtr);
    procedure Dim_text (dp: DialogPtr; item: Integer; dim: Boolean);

{     ---------------------------------------------------------------------}
{    Dim_text            This is a group of routines for dimming text}
{                        items in dialogs.  As is, it assumes that you are}
{                        not using the dialog's refCon for anything else,}
{                        and that you are not using the QuickDraw}
{                        bottlenecks for anything else.}
{    }
{    This code can be used freely.  I ask that you tell me about any}
{    improvements that you think of.}
{    }
{    James W. Walker        March 17, 1994}
{    [e-mail]}
{    [e-mail]}
{    --------------------------------------------------------------------- }

implementation

{$SETC SYSTEM_6_COMPATIBLE    := true}

    procedure Dim_text_proc (byteCnt: Integer; textAddr: Ptr; numerPt: Point; denomPt: Point);
    forward;

    type
        Dim_list_el_Ptr = ^Dim_list_el;
        Dim_list_el = record
                item_num: Integer;
                next: Dim_list_el_Ptr;
                bounds: Rect;
                dim: Boolean;
                editable: Boolean;
            end;

    type
        Dim_data = record
                dim_list: Dim_list_el_Ptr;
                Old_text_proc: ProcPtr;{QDTextUPP}
{$IFC SYSTEM_6_COMPATIBLE}
                has_gray_text: Boolean;
                has_CountDITL: Boolean;
{$ENDC}
            end;
        DimDataPtr = ^Dim_data;


{     ---------------------------------------------------------------------}
{    Get_dim_data        Macro to get the list head.}
{                        Just used to encapsulate the use of the refCon,}
{                        so that if you need to store the list head}
{                        somewhere else you will only need to change this}
{                        and Init_dimmer.}
{    --------------------------------------------------------------------- }

    function Get_dim_data (dp: DialogPtr): DimDataPtr;
    begin
        Get_dim_data := DimDataPtr(WindowPeek(dp)^.refCon);
    end;

{     ---------------------------------------------------------------------}
{    Init_dimmer        Set up a dialog for dimming text.  Call it once, soon}
{                    after creating the dialog.}
{    --------------------------------------------------------------------- }

    procedure Init_dimmer (dp: DialogPtr);
        var
            dim_data_p: DimDataPtr;
            qd_procs: QDProcsPtr;
            val: LongInt;
    begin
        dim_data_p := DimDataPtr(NewPtrClear(sizeof(Dim_data)));
        if (dim_data_p <> nil) then
            begin
        { Store the pointer where we can find it later}
                WindowPeek(dp)^.refCon := LongInt(dim_data_p);

        { Patch the QuickDraw bottleneck for text}
                if BitAnd(dp^.portBits.rowBytes, $8000) = 0 then    { B&W port}
                    begin
                        qd_procs := QDProcsPtr(NewPtrSysClear(sizeof(QDProcs)));
                        SetStdProcs(qd_procs^);
                    end
                else { color port}
                    begin
                        qd_procs := QDProcsPtr(NewPtrSysClear(sizeof(CQDProcs)));
                        SetStdCProcs(CQDProcsPtr(qd_procs)^);
                    end;
                dim_data_p^.Old_text_proc := qd_procs^.textProc;
                qd_procs^.textProc := @Dim_text_proc; {NewQDTextProc(}
                dp^.grafProcs := qd_procs;

{$ifc SYSTEM_6_COMPATIBLE}
        { Which System 7 features are available?}
                dim_data_p^.has_gray_text := (Gestalt(gestaltQuickdrawFeatures, val) = noErr) and (BitAnd(val, BSL(1, gestaltHasGrayishTextOr)) <> 0);
                dim_data_p^.has_CountDITL := (Gestalt(gestaltDITLExtAttr, val) = noErr) and (BitAnd(val, BSL(1, gestaltDITLExtPresent)) <> 0);
{$endc}

                New_dimmables(dp);
            end;
    end; {Init_dimmer}

{     ---------------------------------------------------------------------}
{    Dispose_dimmer        Called once after you are through with a dialog.}
{    --------------------------------------------------------------------- }

    procedure Dispose_dimmer (dp: DialogPtr);
        var
            maybe_null: Ptr;
    begin
        Dispose_dimmables(dp);
        maybe_null := Ptr(Get_dim_data(dp));
        if (maybe_null <> nil) then
            DisposePtr(maybe_null);
        if (dp^.grafProcs <> nil) then
            begin
{DisposeRoutineDescriptor(qd_procs^.textProc);}
                DisposePtr(Ptr(dp^.grafProcs));
            end;
        dp^.grafProcs := nil;
    end; {Dispose_dimmer}

{     ---------------------------------------------------------------------}
{    Dim_text        Set the dimming state of a text item.}
{    --------------------------------------------------------------------- }

    procedure Dim_text (dp: DialogPtr; item: Integer; dim: Boolean);
        var
            dim_head: DimDataPtr;
            dimmable: Dim_list_el_Ptr;
            iRect: Rect;
            iHandle: Handle;
            iType: Integer;
            disable_flag: Integer;
    begin
        dim_head := Get_dim_data(dp);
        if (dim_head <> nil) then
            dimmable := dim_head^.dim_list;
        { Try to find the right item number in the list.}
        while ((dimmable <> nil) and (dimmable^.item_num <> item)) do
            begin
                dimmable := dimmable^.next;
            end;
        if (dimmable <> nil) then    { found it...}
            begin
                dimmable^.dim := dim;
                GetDItem(dp, item, iType, iHandle, iRect);
                if (dimmable^.editable) then

                (*}
{                    To dim an editable text item, we need to turn it}
{                    into a static text item, and also take some care}
{                    that it is not showing the insertion point or a}
{                    selection range.}
{                *)
                    begin
                        disable_flag := BAnd(iType, itemDisable);
                        if dim then
                            begin
                                TEDeactivate(DialogPeek(dp)^.textH);
                                if item = DialogPeek(dp)^.editField + 1 then
                                    begin
                                        SelIText(dp, item, 0, 0);
                                        DialogPeek(dp)^.editField := -1;
                                    end;
                                SetDItem(dp, item, BitOr(statText, disable_flag), iHandle, iRect);
                                DialogPeek(dp)^.editField := -1;
                                TEActivate(DialogPeek(dp)^.textH);
                                InvalRect(iRect);
                            end
                        else
                            begin
                                SetDItem(dp, item, BitOr(editText, disable_flag), iHandle, iRect);
                                SelIText(dp, item, 0, 0);
                                EraseRect(iRect);
                                TEUpdate(iRect, DialogPeek(dp)^.textH);
                            end;
                    end
                else
                    begin
                        InvalRect(iRect);
                    end;
            end;
    end; {Dim_text}


(*    ---------------------------------------------------------------------}
{    Dispose_dimmables        Dispose of the individual dimming items.}
{                            This is called by Dispose_dimmer, so you will}
{                            not ordinarily have to call it directly}
{                            unless you are changing item lists}
{                            dynamically using ShortenDITL and AppendDITL.}
{    ---------------------------------------------------------------------}
{*)
    procedure Dispose_dimmables (dp: DialogPtr);
        var
            dim_head: DimDataPtr;
            next: Dim_list_el_Ptr;
    begin
        dim_head := Get_dim_data(dp);
        while (dim_head^.dim_list <> nil) do
            begin
                EraseRect(dim_head^.dim_list^.bounds);
                next := dim_head^.dim_list^.next;
                DisposePtr(Ptr(dim_head^.dim_list));
                dim_head^.dim_list := next;
            end;
    end; {Dispose_dimmables}

{     ---------------------------------------------------------------------}
{    New_dimmables            Makes all text items in the dialog dimmable,}
{                            both static and editable text.  Called by}
{                            Init_dimmer, so you would not normally need}
{                            to call it directly.}
{                            But if you change the item list using}
{                            ShortenDITL and AppendDITL, you would call}
{                            Dispose_dimmables before the change and call}
{                            New_dimmables after the change.}
{    --------------------------------------------------------------------- }

    procedure New_dimmables (dp: DialogPtr);
        type
            IntPtr = ^Integer;
            IntHnd = ^IntPtr;
        var
            dim_head: DimDataPtr;
            new_dim: Dim_list_el_Ptr;
            iRect: Rect;
            iHandle: Handle;
            iType, item, max_item: Integer;
    begin
        dim_head := Get_dim_data(dp);
        if dim_head <> nil then
            begin
{$ifc SYSTEM_6_COMPATIBLE}
                if dim_head^.has_CountDITL then
                    begin
                        max_item := CountDITL(dp);
                    end
                else
                    begin
                        max_item := IntHnd(DialogPeek(dp)^.items)^^ + 1;
                    end;
{$elsec}
                max_item := CountDITL(dp);
{$endc}

                for item := max_item downto 1 do
                    begin
                        GetDItem(dp, item, iType, iHandle, iRect);
                        if BitAnd(iType, BitOr(statText, editText)) <> 0 then
                            begin
                                new_dim := Dim_list_el_Ptr(NewPtrClear(sizeof(Dim_list_el)));
                                if new_dim <> nil then
                                    begin
                                        new_dim^.next := dim_head^.dim_list;
                                        dim_head^.dim_list := new_dim;
                                        new_dim^.item_num := item;
                                        new_dim^.editable := BAnd(iType, editText) <> 0;
                                        new_dim^.bounds := iRect;
                                        if (new_dim^.editable) then
                                            begin
                                                InsetRect(new_dim^.bounds, -3, -3);
                                            end;
                                    end;
                            end;
                    end;
            end;
    end; {New_dimmables}


{     ---------------------------------------------------------------------}
{    Dim_text_proc            The QuickDraw bottleneck routine that does}
{                            the actual dimming, and also draws the frame}
{                            around dimmed editable text.}
{    --------------------------------------------------------------------- }

    procedure MyCallQDTextProc (byteCnt: Integer; textAddr: Ptr; numerPt, denomPt: Point; myProc: ProcPtr);
    inline
        $205f,     {movea.l  (a7)+,a0        ; (a0) is a ptr to string, 4(a0) is mode}
        $4e90;

    procedure Dim_text_proc (byteCnt: Integer; textAddr: Ptr; numerPt: Point; denomPt: Point);
        var
            item_num: Integer;
            dp: DialogPtr;
            dimmable: Dim_list_el_Ptr;
            dim_head: DimDataPtr;
            gray_rect: Rect;
            save_clip: RgnHandle;
            save_pen: PenState;
    begin
        GetPort(dp);
        dim_head := Get_dim_data(dp);
        item_num := FindDItem(dp, dp^.pnLoc) + 1;
        dimmable := dim_head^.dim_list;
        while ((dimmable <> nil) and (dimmable^.item_num <> item_num)) do
            begin
                dimmable := dimmable^.next;
            end;
        if ((dimmable <> nil) and (dimmable^.dim)) then
            begin
{$ifc SYSTEM_6_COMPATIBLE}
                if dim_head^.has_gray_text then
{$endc}
                    begin
                        TextMode(grayishTextOr);
                    end;
                if dimmable^.editable then
                    begin
                        save_clip := NewRgn;
                        GetClip(save_clip);
                        ClipRect(dimmable^.bounds);
                        FrameRect(dimmable^.bounds);
                        SetClip(save_clip);
                        DisposeRgn(save_clip);
                    end;
            end;

        MyCallQDTextProc(byteCnt, textAddr, numerPt, denomPt, dim_head^.Old_text_proc);
{CallQDTextProc(dim_head^.Old_text_proc, byteCnt, textAddr, numerPt, denomPt);}

{$ifc SYSTEM_6_COMPATIBLE}
        if (not dim_head^.has_gray_text and (dimmable <> nil) and dimmable^.dim) then
            begin
                gray_rect := dimmable^.bounds;
                InsetRect(gray_rect, 1, 1);
                GetPenState(save_pen);
                PenMode(patBic);
{             The reason I used a string literal rather than the QuickDraw}
{            global gray is so that it can be used in a code resource}
{            without problems. }

{        PenPat( (ConstPatternParam) '\xAA\x55\xAA\x55\xAA\x55\xAA\x55' ); Kanke StuffHex?}
                PenPat(gray);
                PaintRect(gray_rect);
                SetPenState(save_pen);
            end;
{$endc}
    end;

end.